perm filename BEAMS.OL2[NEW,LCS] blob
sn#353902 filedate 1978-05-06 generic text, type T, neo UTF8
C**** BEAMS, NREST ***********
SUBROUTINE BEAMS
INTEGER UPDN
COMMON R2,JAZ,CENTR,JBZ,RJQ(20),JQ(20) /STF/RSTFAC(8),RSTJ2
1 /XRN/RN(1) /PTR/KWDS(1) /RNW/RNW
1 /RINP/R(10,85),POSNT(0/99) /RMOD/RMODE2,SET4,IBEAM,
1 NOSET,STEM,STUP,NTC,PS2,RAM,RDD,IT,POS
1 /FRMT/F78F(1),FA1(1),FA5(1),IREAD /ALF/INP(72),ML
1 /LIMIT/LIMIT,ITEM,LL,IS,IX
1 /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
1 /SCX/JALPHA(30),JX,U,JZ,IRHY,JD,KA,KB,IZ
1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
CC DATA BX/25./,BY/.5/,DFAC/6./,CURV/0.9/
C THESE ARE USED TO DETERMINE CURVE OF SLURS AT 63 (21700)
IF(RMODE.LT.500)GO TO 251
IF(MODE.EQ.4)RETURN
C PICKS UP SLURS ONLY WHEN USING SUBR. 'EXTRA' *********
251 INVT=-1
LS=IS
C SAVE PTR TO RN ARRAY FOR SLUR FEATURE AT 614 (AND TREM. FEATURE)
JNTC=NTC
IF(MODE.NE.4)JNTC=JNTC-1
C JNTC=NUM OF NTS NOW
IF(MODE.EQ.3)GO TO 25
IF(REND.NE.0)GO TO 25
REND=3
25 DO 1500 K=1,72
IF(INP(K).EQ.'B')GO TO 22
C B=AUTOMATIC BEAMS.
IF(INP(K).NE.'*')GO TO 1500
15 INP(72)='*'
GO TO 500
1500 IF(INP(K).EQ.ISEMI)GO TO 500
GO TO 15
C ABOVE FOR 2ND LNE OF INPUT. IF LNS ENDS WITHOUT * OR ;, IT PUTS IN *
22 REREAD F78F,A,RB,RC
C TYPE '2B' OR '3B' ETC. FOR AUTOMATIC BEAMS. (2=DUPLE 3=TRIPLE)
IF(IREAD.NE.-1)GO TO 2222
A=RB
RB=RC
C IREAD=-1 WHEN READING SOS FILES. (=-2 WITH ET FILES.)
2222 A=A/2.
C '2'=1 '3'=1.5 '2B 3;' MEANS THERE'S A 3 NOTE PICK-UP.
IF(STEM)STEM=0
C STEM=10 OR 20 IF ALREADY SETUP IN NOTES
N=0
J=0
INP(72)='*'
GR=4./88.
NN=0
NX=0
C NX IS REST COUNTER
NZ=0
NL=1
NJ=0
NR=1
JV=0
C JV IS VX COUNTER
C=0
B=A-.001
IF(RB.EQ.0)GO TO 122
J=RB
C RB=NUM OF PICKUP ITEMS.*******(NTS AND RSTS - BUT NOT GRACE NTS.)*******
B=-.001
DO 222 K=1,J
222 IF(V(K).NE.GR)B=B+ABS(V(K))
C ABOVE FOUND VALUE OF PICKUPS
122 X=ABS(V(NR))
IF(X.NE.GR)GO TO 2122
NN=NN+1
GO TO 2022
2122 C=C+X
C ADD ON RHYTH VALUE -- IF NOT GRACE NOTES
IF(V(NR))N=N+1
C FINDS RESTS AND GRACE NOTES (WE SKIP THEM)
IF(C.GT.B)GO TO 822
CC IF(NOTAIL(X))NL=NR
2022 IF(NR.EQ.IRHY)GO TO 422
922 NR=NR+1
C NR=RIGHT SIDE OF BEAM, NL=LEFT
GO TO 122
CC***822 IF(NR-NL-NN-N.GE.0)GO TO 322
822 IF(NR-NL-NN-N.GT.0)GO TO 322
C IGNORE IF ONLY ONE NOTE FILLS UNIT
CC N=NN+N
C UPDATE REST AND GRACE COUNTER
722 IF(NR.EQ.IRHY)GO TO 422
NN=0
NJ=NJ+N
NZ=NJ
N=0
NL=NR+1
C PUSH AHEAD FOR NEXT BEAM
622 B=B+A
C UPDATE SPACE POINTER
IF(C.GT.B)GO TO 622
GO TO 922
C MAIN AUTO BEAM SECTION.
322 DO 21 K=NL,NR-1
C THIS LOOP FINDS FIRST NOTE OF BEAM.
X=V(K)
IF(X)GO TO 21
IF(X.EQ.GR)GO TO 21
IF(NOTAIL(X))GO TO 21
C SKIP IF NOTE VAL. DOESN'T REQUIRE A TAIL
JV=JV+2
COUNTER FOR VX ARRAY (WHERE WE PUT BEAM'S NOTE NUMS.)
VX(JV-1)=K-NREST(K)
C FUNCT. NREST TELLS HOW MANY RESTS TO SUBTRACT
GO TO 221
21 CONTINUE
C IF WE GET HERE, NO BEAM NOTES FOUND.
GO TO 722
221 DO 321 K=NR,NL,-1
C THIS LOOP FINDS LAST NOTE OF BEAM.
X=V(K)
IF(X)GO TO 321
IF(X.EQ.GR)GO TO 321
IF(NOTAIL(X))GO TO 321
VX(JV)=K-NREST(K)
C NREST SUBTRACTS ALL INTERVENING RESTS
IF(VX(JV).EQ.VX(JV-1))JV=JV-2
CATCHES TRIPLET 1/8 TO TRIPLET 1/4, ETC.
GO TO 722
321 CONTINUE
C NEXT FOR BEAMED GRACE NOTES
422 N=0
J=1
1122 X=V(J)
IF(X)N=N+1
NR=0
IF(X.NE.GR)GO TO 1022
NL=J
DO 1222 K=J,IRHY
X=V(K)
IF(X.OR.X.NE.GR)GO TO 1322
C STOPS GRACE NOTE BEAM AT REST OR NON-GRACE
1222 NR=K
1322 IF(NR-NL.LE.0)GO TO 1022
CALL BAUTO(JV,NL,NR,N)
C UPDATE VX COUNTER
NL=NL+1
J=NR
1022 J=J+1
IF(J.LE.IRHY)GO TO 1122
1422 IF(JV.EQ.0)RETURN
C NO BEAMS - SO GO BACK.
DO 2822 K=JV+1,50
C USES ONLY 68 SLOTS IN 'V'
2822 VX(K)=0
J=0
GO TO 511
C ******* 1ST MAIN LOOP *********
500 REREAD F78F,VX
J=0
IF(IREAD.EQ.-1)J=1
C SKIPS LINE #S IN SOS FILES. (=-2 IS FOR ET FILES.)
511 J=J+1
N=VX(J)
JMP=1
JREP=-1
C JREP IS FOR REPEAT FEATURE IN 'MARKS'
505 L=0
K=0
POS=-10.
IF(MODE.EQ.3)GO TO 5032
C MODE 3 IS FOR ACCENTS ETC.
RN(8+IS)=0
RN(9+IS)=0
IT=0
UPDN=0
IF(MODE.EQ.5)GO TO 104
IF(STEM.EQ.0)GO TO 503
C UPDN=2=STEMS DOWN, (SLUR DIP UP) =1, OPPOSITE.
104 JA=J+1
B=VX(JA)
C THE 2ND NOTE (-=DIP DOWN ALWAYS; +100=UP ALWAYS, ORD.=AUTOMATIC)
IF(B.LT.100)GO TO 512
UPDN=2
B=B-100
IF(B.GT.100)B=100-B
C TYPE -NUM OR 200+NUM FOR DIP DOWN.
VX(JA)=B
512 IF(B)UPDN=1
RN(9+IS)=0
BRK=AMOD(VX(J),1.)*10.
IF(BRK.EQ.0)GO TO 503
C ADDS NUM TO BRACK. OR BEAM. ADD DESIRED .NUM TO 1ST NUM.(1.3=3)
RN(9+IS)=BRK+.0001
GO TO 5030
503 IF(N.GT.0)GO TO 5031
IT=-1
C6/75 POS=-1.3
CALL SLEND
C -1= SLUR INTO 1ST NOTE.
C SETS POS OF LFT SIDE (-10+9, THEN +2)
GO TO 5060
5031 IF(N.LE.JNTC)GO TO 5030
C JNTC=NUM OF REAL NTS+1
C6/75 POS=202
CALL SLEND
C SLEND CHECKS ON END POINTS OF THIS STAFF
GO TO 504
C -1=1ST SLUR FROM NO NOTE; 99= LAST, TO NO NOTE
5032 IF(N.LE.JNTC)GO TO 5030
N=JNTC
C TRAPS ERROR OF TRYING TO PUT MARK ON NON-EXISTENT NOTE.
VX(J)=N
C VX(J)=N IS NEEDED AT LABEL 130
5030 L=L+1
502 K=K+1
IF(R(1,K).NE.1.)GO TO 502
C IS IT A NOTE?
P=R(3,K)
IF(P.EQ.POS)GO TO 502
C SKIPS DBLSTPS
POS=P
506 IF(L.LT.N)GO TO 5030
5060 IF(MODE.EQ.3)GO TO 30
C NOW SLUR STARTS
IF(JMP)GO TO 504
C JMP=-1 MEANS END NOTE OF GROUP
J=J+1
NN=VX(J)
C IF 2ND NUM IS .LE. 1ST , THEN 2-NOTE SLUR. (-1 GOES TO 1)
IF(NN.EQ.0)NN=N+1
IF(NN.EQ.0)NN=1
IF(NN)GO TO 777
IF(NN.LE.N)NN=N+1
C FOR USE WITH AUTO-BEAMS OR DIP UP. 2-NOTE SLUR OR BEAM UP.
777 IF(MODE.NE.4)GO TO 5061
IF(STEM.LE.0)GO TO 5061
C AUTOMATIC DIP DIRECTION FOR SLURS WITH AUTO. BEAMS.
177 MK=K
877 IF(R(1,MK).EQ.1)GO TO 477
MK=MK+1
GO TO 877
C FOR SLUR INTO FIRST NOTE WITH AUTO BEAMS.
477 IF(R(10,MK).EQ.0)GO TO 1077
C SKIP NOTES ON ANOTHER STAFF.
MK=MK+1
GO TO 477
1077 A=19.-R(5,MK)
IF(NN.GE.0)GO TO 277
IF(A.GT.0)GO TO 377
277 IF(A.GE.0)GO TO 5061
IF(NN.LE.0)GO TO 5061
377 NN=-NN
5061 MK=N
N=IABS(NN)
M=K
JA=3
JB=4
KN=K
RB=0
IF(MODE.EQ.4)GO TO 550
IBR=6
C 6=SLUR, 7=BRACK. FOR TRIPLETS, ETC.
CC*** NOT NEEDED NOW WITH UPDN FEATURE. IF(STEM.GE.0)NN=-NN
IF(IT)GO TO 550
C IT=-1=SLUR INTO 1ST NOTE.
A=XNOTE(K)
C XNOTE IS AMOD(R(4,K),100.)
C SAVES LEVEL OF 1ST NOTE.
504 RB=2
CS B=AMOD(R(6,K),1.0)
CS IF(B.GE.0.5)RB=3.
CS IF(B.EQ.0.4)RB=5.
C THESE ARE FOR >(.5) AND ∧(.4) ACCENTS
IF(NN)RB=-RB
C DIP IS SET BY PARAM 7. (STEM DIR. IS AUTOMATIC)
550 RN(JA+IS)=POS
B=XNOTE(K)
IF(MODE.EQ.4)GO TO 519
C TO MAKE MINI-BEAMS ON GRACE NOTES WHEN NEEDED.
IF(MODE.NE.5)GO TO 513
SLUR=0
C A FLAG FOR LATER USE.
JA=K
IF(JA.NE.0)GO TO 451
1451 JA=JA+1
IF(R(1,JA).NE.1)GO TO 1451
451 MB=R(5,JA)/10.
IF(MB.NE.0)GO TO 450
MB=1
X=R(4,JA)
IF(X.GT.80)X=X-100
IF(X.GT.6)MB=2
450 IF(UPDN.EQ.0)GO TO 515
CCC??? IF(MB.EQ.0)MB=UPDN
C MB=0 IF 2ND NOTE IS WITHOUT STEM
IF(MB.EQ.UPDN)GO TO 515
X=6
IF(NN)X=-X
CS IF(RB)X=-X
RB=RB+X
JA=3
IF(JMP)JA=6
IF(NN)GO TO 204
CS IF(RB)GO TO 204
IF(UPDN.EQ.2)GO TO 516
204 IF(UPDN.EQ.1)GO TO 516
C ABOVE FOR VARIOUS COMBINATIONS OF STEM DIRECTIONS
RB=-RB
NN=-NN
516 IF(K.GT.1)GO TO 16
IF(IT)GO TO 513
16 IF(K.NE.JNTC)GO TO 116
IF(N.GT.JNTC)GO TO 513
C JUMP IF N=99, BY PASS IF K IS NOT LAST NOTE OF LINE.
CCC116 SLUR=1.
116 SLUR=0.5
IF(UPDN.EQ.1)SLUR=-SLUR
SLUR=SLUR*RSTJ2
RN(JA+IS)=RN(JA+IS)+SLUR
C THIS NOT DONE IF SLUR TO FIRST NOTE
GO TO 513
519 SDIF=R(10,K)
IF(SDIF.EQ.0)GO TO 513
C JUMP IF IT'S NOT ON DIFF STF.
RA=RSTJ2*RNW
C NOTE WIDTH = RNW
IF(ABS(R(4,K)).LT.80)GO TO 520
RA=RA*.6
IF(JMP)B=B-100
C MINI
520 IF(SDIF.EQ.2)RA=-RA
C STAFF ABOVE
RN(JA+IS)=POS+RA
C ***** THIS CAN BE OFF A LITTLE IN SOME CASES!!******
SDIF=SDIF*5
IF(SDIF.NE.10)SDIF=20
CHANGES 1 TO 20, 2 TO 10.
GO TO 513
517 IF(MB.EQ.1)GO TO 513
IF(RB)RB=-RB
GO TO 518
515 UPDN=MB
C AUTO SLUR DIP DEPENDS ON STEM DIREC. OF 1ST NOTE. (WHOLE NTS??)
IF(NN)GO TO 517
IF(MB.NE.1)GO TO 513
RB=-RB
518 NN=-NN
513 RN(JB+IS)=B+RB
C MK=# OF 1ST NOTE, N=END NOTE NOW
JMP=-JMP
IF(JMP.GT.0)GO TO 1503
C GO FIND RT. SIDE OF SLUR
JA=6
JB=5
IF(N.LE.MK)N=MK+1
C PICKS UP TYPO ERRORS
JK=0
IF(R(7,K).GE.10)JK=-1
C CHECKS FOR DOT AFTER 1ST NOTE -- FOR TIES.
GO TO 503
1503 RN(2+IS)=STAFF
IF(MODE.EQ.4)GO TO 35
5503 RN(8+IS)=-1
RN(1+IS)=5
IF(IT)RN(4+IS)=RN(5+IS)
NN=-NN
C IF NN IS NEG. NOW IT MEANS STEM DOWN.(DIP IS UP!)
IF(N.EQ.99)GO TO 200
C TYPE /n 99/ FOR SLUR BEYOND NOTE HEAD (TO DIFF. PITCH ON NEXT LINE)
C /n x/ IS TIE TO SAME NOTE ON NEXT LINE. (X IS ANY NUMBER > LAST NOTE NUM.)
IF(MK.EQ.-99)GO TO 200
C TYPE /-99 n/ FOR SLUR FROM DIFF. NOTE ON PREVIOUS LINE.
C /0 n/ OR /-1 n/ IS TIE FROM SAME NOTE, PREV. LINE
C=0
C C WILL BE FLAG IN SECTION ON TIES BETWEEN CHORDS (AT 114)
AA=XNOTE(K)
IF(MK.EQ.JNTC)GO TO 61
C JNTC (NOTE COUNT) THE LAST NOTE(OR CHORD) OF INPUT
IF(N.EQ.1)GO TO 61
IF(IT)GO TO 2114
CXX IF(XNOTE(K).NE.A)GO TO 60
IF(N-MK.GT.1)GO TO 2114
CCC IF(R(5,M).NE.R(5,K))GO TO 65
CCC FOR SLUR OVER CHROMATIC CHANGE ON SAME NOTE NAME.
C M=1ST NOTE OF SLUR, K=LAST
B=R(5,K)
IF(AMOD(B,10.0).GT.0)GO TO 65
C JUMP IF LAST NOTE HAS ACCI.
C JUMP IF NOT ADJACENT NOTE AT SAME PITCH AND NOT 1ST OR LAST.
CXX61 C=9
CXX IF(JK)C=12
CXX IF(RN(6+IS)-RN(3+IS)-C*RSTJ2)GO TO 65
C JUMP IF SLUR IS VERY SHORT
IF(AA.EQ.A)GO TO 61
C NEXT FOR NOTES AT DIFFERENT LEVELS
IF(B.LT.20)GO TO 161
C ARE STEMS THE SAME DIRECTION. JUMP OUT IF SO.
IF(R(5,M).GE.20)GO TO 2114
GO TO 61
161 IF(R(5,M).LT.20)GO TO 2114
61 IF(IT)A=AA
C IT=-1=SLUR INTO 1ST NOTE.
CXX C=9
CXX IF(JK)C=12
C=6
IF(JK)C=8
C=RN(6+IS)-RN(3+IS)-C*RSTJ2
CATCHES VERY SHORT SLURS
CXX A=A+.7
B=-.7
IF(C.OR.A.NE.AA)B=-1.8
CXX IF(NN.GT.0)A=A-1.4
IF(NN)B=-B
C TO RAISE OR LOWER IT .7
RN(4+IS)=A+B
RN(5+IS)=AA+B
CXX RN(5+IS)=A
B=-2
IF(JK)B=-3
C JK=-1 WHEN NOTE IS DOTTED.
C THIS PUTS TIE BETWEEN (NOT ABOVE OR BELOW) NTS. NO STEM CHNG.
IF(C)B=-1
RN(8+IS)=B
IF(SLUR.EQ.0)GO TO 65
RN(3+IS)=RN(3+IS)-SLUR
RN(6+IS)=RN(6+IS)-SLUR
C PUSH SLUR BACK TO WHERE IT WAS
GO TO 65
C NEXT TO SHIFT SLUR IN RE. TO MARKS. STAC., TEN., ACC.
C ***********KN = 1ST NOTE, K=LAST NOTE.********
2114 JA=KN
JB=4
2503 RB=R(2,JA)
IF(RB.EQ.0)GO TO 3503
IF(BRK.NE.0)GO TO 6503
C IS IT A BRACKET INSTEAD OF A SLUR?
IF(RB.EQ.4.OR.RB.EQ.5)GO TO 4503
IF(RB.NE.7.AND.RB.NE.9)GO TO 3503
6503 RB=1.5
IF(R(5,JA).LT.20)RB=-RB
RN(IS+JB)=RN(IS+JB)+RB
GO TO 3503
4503 L=R(9,JA)
C THE POINTER TO P11 WAS SAVED HERE BY 'NEWR'
RN(L)=RN(L)+.2
3503 IF(JA.EQ.K)GO TO 60
JA=K
JB=JB+1
GO TO 2503
C** 6/16/75 60 IF(STEM.GE.0)GO TO 508
60 IF(STEM.GE.0)GO TO 200
IF(MODE.EQ.5)GO TO 200
C JUMP IF SLURS**************
C NEXT IS STEM INVERTER. SKIP IF AUTOMATIC BEAMS OR 'SU' 'SD' IN USE.
JB=1
RB=10.
IF(NN)GO TO 509
C IF NN IS NEG. NOW IT MEANS STEM DOWN.(DIP IS UP!)
RB=-RB
JB=2
509 DO 507 L=M,K
IF(R(1,L).NE.1.)GO TO 507
JA=R(5,L)/10.
IF(JA.NE.JB)GO TO 507
IF(R(10,L).NE.0)GO TO 507
C LEAVE NOTE ON OTHER STAFF ALONE.
R(5,L)=R(5,L)+RB
INVT=0
C**********************************************
507 CONTINUE
GO TO 200
62 IF(NN)GO TO 64
IF(A.EQ.DMAX)GO TO 65
AA=B-DMAX
GO TO 63
65 AA=0
GO TO 63
64 IF(A.EQ.UMAX)GO TO 65
AA=UMAX-B
63 RA=RN(6+IS)
RB=RN(3+IS)
CC DATA BX/25./,BY/.5/,DFAC/6./,CURV/0.9/
X=0.9+(RA-RB)/25.+ABS(RN(4+IS)-RN(5+IS))/10.
CC X=CURV+(RA-RB)/BX+ABS(RN(4+IS)-RN(5+IS))/10.
C CURVE DEPENDS ON LENGTH, TILT AND NOTES BETWEEN.
CC IF(AA.GT.0)X=X+AA*BY
IF(AA.GT.0)X=X+AA*.5
IF(BRK.EQ.0)GO TO 66
RN(8+IS)=1
RN(3+IS)=RB-.6
RB=R(3,K+1)
C K=END NOTE OF GROUP
IF(K.EQ.IZ)RB=200.
C IZ IS LAST ITEM IN R(N,M)
C**** IF(K.EQ.IRHY)RB=200.
C ASSUMES LINE STOPS AT 200. (IT COULD BE LONGER!!)
RN(6+IS)=RA+(RB-RA)/2.
IBR=7
C CHECK THESE NUMBERS↑↑↑↑
B=RN(4+IS)
BB=RN(5+IS)
RA=1
IF(A.LT.-1)RA=2.5
C CHANGES HEIGHT. MAKES BRACK. IF N>100.
IF(NN.GT.0)RA=-RA
RN(4+IS)=B+RA
RN(5+IS)=BB+RA
X=2
66 IF(NN.GT.0)X=-X
510 RN(7+IS)=X
IF(MODE.NE.4)GO TO 2514
CC RN(9+IS)=0
RN(10+IS)=0
RN(IS+11)=-1
CALL UPDATE(9)
IF(JB)CALL BMX(RA)
GO TO 514
2514 L=IS
CALL UPDATE(IBR)
CC IF(M.EQ.K)GO TO 514
IF(C.EQ.0)GO TO 514
C JUMP OUT IF INTERVENING NOTE. C≠0 = TIE BETWEEN NOTES
IF(RN(L+4).NE.RN(L+5))GO TO 514
C IS IT LEVEL?
B=-RN(IS-2)
C CHANGE DIRECTION OF DIP AFTER FIRST SLUR.
CZZ RA=1.4
RA=.7
IF(RN(L+8).EQ.-1)RA=RA+1.3
C IS TIE NOT BETWEEN NOTES?
IF(NN.GT.0)RA=-RA
C DIP DIRECTION. NN+ =DOWN, NN- =UP. REVERSED AFTER 1ST ONE.
CZZ RA=XNOTE(M)+RA
C=-2.
IF(RN(L+8).EQ.-3.)C=-3.
C PUT TIE BETWEEN NOTES ALWAYS.
JA=M
JB=K
IF(MK)JA=JB
C FOR TIES TO 1ST OF LINE
IF(N.GT.JNTC)JB=JA
C FOR END OF LINE CHORDS JNTC=TOTAL OF NOTES (NOTE COUNT)
RC=R(3,JA)
114 JA=JA+1
JB=JB+1
IF(RC.NE.R(3,JA))GO TO 514
CC IF(R(3,JB).NE.POS)GO TO 514
C JUMP IF RIGHT-HAND NOTE NOT IN SAME POS.
IF(R(1,JA).NE.1)GO TO 514
C CATCHES THINGS BETWEEN NOTES
IF(R(4,JA).NE.R(4,JB))GO TO 514
C LOOKS FOR PARALLEL CHORDS NOTES
CRH IF(R(9,JA)+R(9,JB).NE.0)GO TO 514
C MAKES SURE THEY ARE CHORD NOTES.
A=XNOTE(JA)
BB=RA
IF(AMOD(A,2.0).EQ.0)BB=BB/2.
C MOVE SLUR 1/2 IF IT WOULD LAND ON A SPACE (EVEN NUMS).
A=A-BB
CZZZ A=XNOTE(JA)-RA
CZZ A=XNOTE(JA)-RA+RN(L+5)
RN(IS)=6.
RN(IS+1)=5.
RN(IS+2)=RN(IS-7)
RN(IS+3)=RN(IS-6)
RN(IS+6)=RN(IS-3)
RN(IS+7)=B
RN(IS+8)=C
RN(IS+4)=A
RN(IS+5)=A
CALL UPDATE(IBR)
GO TO 114
514 J=J+1
A=VX(J)
N=A
C SO ITEMS NEED NOT BE IN RIGHT ORDER.
IF(MOD(N,100).GT.IRHY)A=0
IF(A.NE.0)GO TO 505
CC***USE NO NUMBS IN COMMENTS IN MODE 3-5****** IF(VX(J+2).EQ.0)GO TO 614
IF(J.LT.50)GO TO 514
C SOMETIMES A SLASH IS SEEN AS A 0 (WHEN PRECEDED BY SPACE).
614 IF(INP(72).NE.'*')GO TO 552
IF(MODE.NE.5)GO TO 714
C NEXT FOR TWO SLURS ON SAME POS. LOOKS AT LEFT SIDE FIRST.
NS=LS
C NEXT ARE PARAMS 4, 3, 6 OF SLUR. 2ND TIME AROUND USE 5, 6, 3.
N=4
NA=3
NB=6
1314 IF(RN(LS+8).LT.-1)GO TO 714
C SKIP OUT IF SLUR IS IN BETWEEN NOTES (P8=-2 OR -3)
JS=LS
X=1.8
IF(RN(LS+7))X=-X
A=RN(LS+NA)
B=RN(LS+NB)
C A AND B ARE THE TWO HORIZ. POSITIONS. RA IS HEIGHT.
RA=RN(LS+N)
814 MB=RN(JS)+JS+3
C MB IS THE NEXT SLUR
IF(MB.LT.IS)GO TO 1514
LS=RN(LS)+LS+3
C MOVE AHEAD ONE SLUR
IF(LS.GE.IS)GO TO 1214
GO TO 1314
1514 IF(RN(MB+8).LT.-1)GO TO 1014
IF(A.NE.RN(MB+NA))GO TO 1014
D=RN(MB+NB)
C MAYBE PUT IN SOMETHING HERE TO CATCH SLURS WITH OPPOSITE DIPS.
JB=MB
IF(N.EQ.5)GO TO 1414
IF(B.GT.D)JB=LS
GO TO 1114
1414 IF(D.GT.B)JB=LS
1114 BB=RN(N+JB)
IF(ABS(BB-RA).LT.0.5)RN(N+JB)=BB+X
C SHIFT HEIGHT OF SLUR ONLY IF HEIGHT IS CURRENTLY THE SAME.
1014 JS=MB
GO TO 814
1214 IF(N.EQ.5)GO TO 714
C START AGAIN, LOOK AT RIGHT END OF SLURS NOW
N=N+1
NA=6
NB=3
LS=NS
GO TO 1314
714 IF(INVT)RETURN
INVT=IS
CALL NEWR
IS=INVT
RETURN
552 CALL BMREAD
CC552 IF(IREAD.NE.0)GO TO 3501
CC CALL TYPE
CC WRITE(21,4501)INP
CC GO TO 5501
CC3501 IF(IREAD.EQ.-1)READ(22,2501)J,INP
CC IF(IREAD.EQ.-2)READ(22,4501)INP
CC CALL TYPOUT
CC5501 CALL LNEND
C FOR NEW 'SCORE' CONVENTIONS
C TO READ MORE THAN 2 LINES.
GO TO 25
C FOR 2ND LINE.
CC4501 FORMAT(72A1)
CC2501 FORMAT(I,72A1)
35 RA=10.
C RA WILL=# OF TAILS, KN=1ST NOTE, K=LAST ('MOD' FOR DOTTED NOTES.)
RN(1+IS)=6
JMAX=0
IF(N-MK.EQ.1)JMAX=-1
DMAX=100.
UMAX=-DMAX
C FOR AUTO. BEAMS
JB=0
MB=0
C MB=-1 =GRACE NOTES UNDER BEAMS.
IF(ABS(R(4,KN)).GE.80.)MB=-1
DO 2 L=KN,K
IF(R(1,L).NE.1)GO TO 2
IF(R(10,L).NE.0)GO TO 2
C SKIP NOTES ON ANOTHER STAFF.
BB=R(5,L)
IF(BB.GE.10.)GO TO 12
UPDN=-1
NN=19-AA
CHORDS WILL HAVE FIXED STEM DIRECTIONS ALWAYS
GO TO 2
C SKIPS NON-NOTES AND DBLSTPS
12 IF(MB)GO TO 10
AA=BB
RB=R(4,L)
IF(ABS(RB).GE.80)GO TO 2
C SKIPS GRACE NOTES
GO TO 110
10 RB=XNOTE(L)
110 IF(RB.GT.UMAX)UMAX=RB
IF(RB.LT.DMAX)DMAX=RB
C FOR AUTO. BEAMS
RB=AMOD(R(7,L),10.0)
112 IF(RA.EQ.RB)GO TO 2
JB=-1
C FLAG FOR MIXED NUM. OF BEAMS
IF(RB.GE.RA)GO TO 2
IF(RB.NE.0)RA=RB
2 CONTINUE
C ABOVE FINDS SMALLEST # OF TAILS. NEXT FOR HGTS.
C ABOVE IS POS.2
IT=K
C FOR EXTRA BEAMS WITH CHORDS. SAVE IT IN "IT"
IF(STEM.GT.0)GO TO 577
C *****↑↑↑↑↑↑ ABOVE WAS ".NE." BEFORE 4/30/76. WHY?#@&Xαε
IF(UPDN.NE.0)GO TO 577
IF(UMAX+DMAX.GE.14)NN=-1
CXX IF(STEM.GT.0)NN=10.-STEM
C SETS AUTO. BEAMS' STEM DIRECTION.
577 X=10
IF(NN)X=20
IF(SDIF.NE.0)X=SDIF
IF(MB)RA=2
C 2 BEAMS ON GRACE NOTES ALWAYS
X=X+RA
C # OF BEAMS. IT'S PUT IN DOWN BELOW 550.
200 M=KN
207 L=M+1
IF(R(1,L).NE.1)GO TO 307
CC IF(R(9,L).NE.0)GO TO 307
IF(R(5,L).GE.10)GO TO 307
M=M+1
GO TO 207
C FOR HEIGHTS OF DBL STPS, ETC.
307 IF(R(10,M).EQ.0)GO TO 607
M=M+1
C SKIP NOTES ON OTHER STAFF
GO TO 307
607 A=XNOTE(M)
CW307 A=XNOTE(M)
C A=NOTE 1.
UMAX=A
DMAX=A
C UP MAX. NOTE #, DOWN MAX. NOTE #.
407 M=K+1
IF(R(1,M).NE.1)GO TO 103
CC IF(R(9,M).NE.0)GO TO 103
IF(R(5,M).GE.10)GO TO 103
C FINDS DBL+ STP ON LAST OF BEAM
IF(R(6,M))GO TO 103
C JUMP OUT IF A WHITE NOTE
K=M
GO TO 407
103 DO 3 M=KN,K
IF(R(1,M).NE.1)GO TO 3
IF(R(10,M).NE.0)GO TO 3
C SKIP NOTES ON OTHER STAFF
IF(M.EQ.K)GO TO 107
CW IF(R(10,M).NE.0)GO TO 107
IF(R(1,M+1).NE.1)GO TO 107
C IT ONLY CARES ABOUT NOTES!
CC IF(R(9,M+1).EQ.0)GO TO 3
IF(R(5,M+1).LT.10)GO TO 3
C IGNORE LOWER (OR UPPER) NOTES OF CHORDS (NO STEM)-IN RE. UP-DOWN FEATURE.
107 IF(MB)GO TO 7
C SKIP IF DEALING WITH GRACE NOTE BEAMS. (MB=-1)
IF(ABS(R(4,M)).GE.100)GO TO 3
C SKIPS NON-NOTES
7 B=XNOTE(M)
IF(MODE.EQ.5)GO TO 55
677 IF(R(10,M).NE.0)GO TO 55
C DON'T CHANGE STEM DIR. IF NOTE IS ON OTHER STAFF!!!!
STMDR=R(5,M)
IF(NN.GT.0)GO TO 5
C JUMP IF STEM UP
IF(STMDR.GE.20.)GO TO 55
IF(STMDR.LT.10.)GO TO 55
R(5,M)=STMDR+10.
GO TO 551
5 IF(STMDR.LT.20.)GO TO 55
R(5,M)=STMDR-10.
C************************
C STEM UP
551 INVT=0
55 IF(B.LT.UMAX)GO TO 13
CC55 IF(B.LE.UMAX)GO TO 13
C ↑↑↑↑↑↑↑↑ WAS .LT. !!!!! 5/76
UMAX=B
IF(JMAX)GO TO 3
IF(M.EQ.KN)GO TO 3
IF(M.EQ.K)GO TO 3
UMAX=UMAX+1
GO TO 3
13 IF(B.GT.DMAX)GO TO 3
DMAX=B
IF(JMAX)GO TO 3
IF(M.EQ.KN)GO TO 3
IF(M.EQ.K)GO TO 3
DMAX=DMAX-1
3 CONTINUE
C LOOKS FOR LOWER AND HIGHER NOTES THAN NOTE 1.
4 IF(MODE.EQ.5)GO TO 62
K=IT
C FOR EXTRA BEAMS WITH CHORDS. K WAS SAVED IN "IT"
AA=A
BB=B
C=1
IF(X.LT.20.)GO TO 48
C JUMP IF STEM IS UP
CALL EXCH(AA,BB)
C=-C
CALL EXCH(UMAX,DMAX)
48 IF(AA.LT.BB)GO TO 45
IF(UMAX.EQ.A)GO TO 46
47 A=UMAX-C
B=A
GO TO 444
46 IF(UMAX.GT.AA)GO TO 47
GO TO 49
45 IF(UMAX.NE.B)GO TO 47
49 A=AA
B=BB
IF(X.GE.20)CALL EXCH(A,B)
444 RN(2+IS)=STAFF
446 DIS=(RN(IS+6)-RN(IS+3))/6.
CC446 DIS=(RN(IS+6)-RN(IS+3))/DFAC
C FOR TILT LATER -- DFAC IS IN DATA
IF(ABS(A-B).LT.DIS)GO TO 143
C=C*DIS
C NEW TILT ROUTINE. CONSIDERS DISTANCE:HEIGHT
C LIMITS SLOPE OF BEAM
IF(X.GE.20)GO TO 141
IF(B.GT.A)GO TO 140
142 B=A-C
GO TO 143
141 IF(B.GT.A)GO TO 142
140 A=B-C
143 BB=A
IF(STMDR.GE.20)GO TO 530
IF(B.LT.A)BB=B
C BB IS LOWEST SIDE OF BEAM
IF(BB.GE.0)GO TO 14
C BEAM WILL ALWAYS TOUCH MIDDLE LINE OF STAFF
BB=-BB
GO TO 430
530 IF(B.GT.A)BB=B
C FOR STEMS DOWN
IF(BB.LE.14)GO TO 14
C BEAMS WILL ALWAYS TOUCH MIDDLE LINE OF STAFF
BB=14-BB
430 A=A+BB
B=B+BB
C GETS NEW HEIGHT NUMBERS.
14 IF(MB.EQ.0)GO TO 330
C NEXT FOR GRACE NOTE BEAMS (MB=-1)
C=100
IF(A)C=-C
A=A+C
330 C=AMOD(X,10.0)-2
IF(C.LE.0)GO TO 331
C NEXT PUSHES OUT BEAMS IF 3 OR MORE.
C=C+1
IF(NN)C=-C
A=A+C
B=B+C
331 RN(4+IS)=A
RN(5+IS)=B
C MAKES HORIZONTAL BEAMS IF PATTERN IS UP-DOWN.
C*******?????? RN(6+IS)=R(3,K)
C ABOVE IS POS.2
C NEXT TO FIND TREMOLOS WHICH SHOULD BE PARALLEL TO BEAM.
JA=IX
AA=RN(IS+3)
BB=RN(IS+6)
300 IF(JA.GE.LS)GO TO 510
C LS IS PTR TO RN ARRAY BEFORE BEAMS WERE ADDED.
IF(RN(JA+1).EQ.6)GO TO 1300
2300 JA=RN(JA)+JA+3
C PUSH PTR AHEAD
GO TO 300
1300 C=RN(JA+3)
IF(C.LT.AA.OR.C.GT.BB)GOTO 2300
C NOW WE'VE FOUND TREM. WITHIN RANGE OF CURRENT BEAM.
RN(JA+9)=C
RN(JA+3)=AA
RN(JA+6)=BB
RN(JA+4)=A
RN(JA+5)=B
C=RN(JA+7)
IF(C.GT.-20.)GO TO 3300
IF(X.LT.20.)C=C+10
GO TO 4300
3300 IF(X.GE.20)C=C-10
4300 RN(JA+7)=C
C X=P7 INFO FOR CURRENT BEAM. (STEM DIR., NUM. OF BEAMS.)
RN(JA+10)=ABS(AMOD(X,10.0))
GO TO 2300
C NEXT IS FOR ACCENTS AND OTHER MARKS
30 IF(JREP)CALL MARKS(RA)
RB=0
C%%%%%%%%
J=J+1
IF(RA.GE.30.AND.RA.LE.35)VX(J+1)=0
C THIS ↑↑↑↑ CATCHES FINGERING NUM.(0-5) IT WAS READ IN MARKS.
IF(RA.EQ.99)RA=VX(J)
C IF STEM IS DOWN OR THERE ARE NOTES BELOW(DBL STP), POSITION
C OF ACCENT WILL BE INVERTED.
130 IF(RA.LT.37)GO TO 304
C 37=RIT.
C=POSIT(VX(J-1))-1.5
C '-1.5' PUSHES IT TO LEFT. MAYBE CHANGE ORIGINAL POSITIONS??
IF(RA.LE.60.OR.RA.GT.63)GO TO 308
C NEXT FOR TREMOLO: TM, TME, TMS, =32ND, 8TH, 16TH
NN=11
A=8
C A IS WDCNT-2
B=6
C CODE NUM. IS IN B
C=C+1.5
C FIND POSITION OF THIS NOTE
BB=R(4,K)
C BB=HEIGHT
RC=AMOD(R(7,K),10.0)
C LOOK FOR TAILS
X=0
IF(RA.EQ.61)X=1
C RA=61= 8TH NOTE BEAM
AA=R(8,K)
C TREM. POS. WILL DEPEND ON NOTE POS. AND STEM LENGTH
IF(AA.NE.0)GO TO 2309
AA=1-X
R(8,K)=1.2-X
2309 AA=AA-1
C AA = AMOUNT TO BE ADDED OR SUBTRACTED WITH HEIGHT OF NOTE
IF(R(5,K).GE.20)GO TO 1309
C CHECK ON STEM DIRECTION
X=-(RA-50)
C MAKES -11, -12, -13, ETC.
CV IF(RC.EQ.0)GO TO 309
CV X=-12
CV NO C PUSH TREM UP OR DOWN 2 IF TAIL
IF(RC.NE.0)BB=BB-2
GO TO 309
1309 X=-(RA-40)
C MAKES -21, -22, ETC.
AA=-AA
IF(RC.NE.0)BB=BB+2
309 BB=BB+AA
C OK FOR 16TH AND 32ND - BUT 8TH NEEDS MORE WORK******
RN(IS+7)=X
RN(IS+6)=0
C EXTEND THE STEM
RC=0
RN(IS+8)=0
RN(IS+9)=0
RN(IS+10)=0
C ABOVE IS TO LEAVE ROOM FOR CHANGE OF TREM TO BE PARALLEL TO OTHER BM.
GO TO 305
308 NN=6
RC=RA
BB=-6
A=3
B=3
IF(XNOTE(K).LT.3)BB=XNOTE(K)-7.5
C LOWERS ITEM IF NOTE BELOW STAFF. BUT IS 'K' ALWAYS OK HERE??????
IF(RA.LT.99)GO TO 305
C NEXT FOR CRESC. & DECRSC. LINES<,>. TYPE /NT1 C+ NT2/ OR /N1.d C- N2.d/
C ALSO FOR "8va ----" /NT1 O NT2/
NN=8
BB=BB+2.5
A=5
B=4
RB=50
IF(RA.NE.208)GO TO 306
RB=0
B=7
BB=15
C LATER ADD CHECK FOR HEIGHT OF NOTES UNDER 8va.
306 RN(IS+7)=RA-200
C MAKES ZERO OR -1 OR 8 IN P7
RC=RB
C ADDS A NEW ITEM. MP, PP, CRESC., ETC. --CODE 3
305 RN(IS)=A
RN(IS+1)=B
RN(IS+2)=STAFF
C PUTS MF, ETC. BETWEEN NOTES. (I HOPE) SEE 'FUNCTION POSIT' BELOW
RN(IS+3)=C
C C HAS HORIZONTAL POS.
RN(IS+4)=BB
C DIST. BELOW STAFF
RN(IS+5)=RC
C THE CODE NUM IN 'CLEFS' LIST
IS=IS+NN
IF(B.EQ.3.OR.B.EQ.6)GO TO 230
CC IF(NN.EQ.6.OR.B.EQ.6)GO TO 230
C B=6=TREM. NN=6=WORDS OR LTRS. UNDER STAFF.
J=J+1
RC=POSIT(VX(J))
IF(RB.EQ.0)RC=RC+3
C RB=0= 8va
RN(IS-2)=RC
C THIS IS P6 (POS2 FOR CRESC. LINES)
GO TO 514
CS304 RB=R(6,K)
CS B=10.
CS IF(RA.EQ.6)RA=26.
C TEMPORARY CHANGE FOR FERMATA*******
CS IF(RA.GT.10.)RA=RA/10.
CS A=ABS(AMOD(RB,1.))
CS IF(A.EQ.0)GO TO 301
CS IF(RA.GT.3)GO TO 303
CS RB=FLOAT(IFIX(RB))
CS RA=RA+A/10.
C THIS PUTS 2-DIGIT CODE BEFORE 1-DIGIT CODE.
CS GO TO 301
CS303 IF(A.LT..3)GO TO 302
CS B=100.
CS GO TO 301
CS302 B=1000.
CS301 IF(RB.LT.0)RA=-RA
CS R(6,K)=RB+RA/B
304 RB=R(2,K)
IF(RA.EQ.6)RA=26.
A=RA
IF(RB.EQ.0)GO TO 301
IF(RB.GE.10)GO TO 303
A=A*100
GO TO 301
303 RB=RB*100
301 R(2,K)=RB+A
C P11 INFO(MARKS) IS TEMPORARILY STORED IN P2 (STAFF# IS IN STAFF)
230 A=VX(J)
JREP=-1
IF(A.EQ.0)GO TO 514
C NEXT FOR STRING OF SAME MARK ( /3 12 S/ )
IF(A.GT.JNTC)A=JNTC
C WON'T PUT MARK BEYOND LAST NOTE
JREP=0
J=J-1
VX(J)=VX(J)+1
IF(VX(J).GE.A)VX(J+1)=0
J=J-1
GO TO 514
C USES 4-7,9,11-13 FOR ACC. > FERM. DOT - DNBOW UPBOW HARM.
C NOTE#,ACCENT#/N,A/N,A*
END
FUNCTION NREST(K)
COUNTS REST FROM START OF LINE UP TO ITEM K-1 (K IS A NOTE)
COMMON /SCM/V(1)
NREST=0
DO 1 J=1,K-1
1 IF(V(J))NREST=NREST+1
END